// scaup - Scala up!
// (c) 2009, Normen Müller, normen.mueller@gmail.com  
// $Id: Parser.scala 6 2009-11-06 20:06:43Z normen.mueller $
package locutor.parsing.model.gm

import java.io.File

import collection.mutable.HashSet

import scaup.Views._

import locutor.model.GraphModel

/** A graph model parser.
 * 
 * At the moment only primitive string representations of graph models are supported.
 * No need for sophisticated AST yet due to direct looping into GrGEN.
 * 
 * Parsing restrictions:
 * - Can't parse, for example, ``const operatorMap:map<dom_AssignmentOperatorKind, string> = { ... }''
 * 
 * @author <a href="mailto:normen.mueller@googlemail.com">Normen M&#xFC;ller</a>
 * @version 0.0.2 */
private [gm] class Parser extends ExpressionParser {
  /* locutor models root path */
  private val LOCUTOR_MODELS = System.getProperty("locutor.models").toFile
  
  /* Fill in abstract defs*/
  type Tokens = Lexer
  val lexical: Tokens = new Lexer
  
  /* Configure lexical parsing */                                 
  lexical.reserved ++= new HashSet[String] ++ List(    
    "abstract", "arbitrary", 
    "boolean",
    "const", "class", "connect",
    "directed",
    "enum", "edge", "extends",
    "inherited",
    "object",
    "model",
    "node",   
    "undirected", 
    "set"
  ) ++ ExpressionParser.reserved
  
  lexical.delimiters ++= new HashSet[String] ++ List(
    "{", "}",
    "->", "--", "<->",
    ";", "="
  ) ++ ExpressionParser.delimiters
  
  /* Define the grammar */
  lazy val gm: Parser[GraphModel] = ("model" ~> ident) ~ opt(upper) ~ ("{" ~> stmts <~ "}") ^^ {
    case name ~ upper ~ stmts => new GraphModel(name, stmts) ++ upper      
  }
  
  lazy val upper = "extends" ~> (ident ~ (("," ~> ident)*)) ^^ {
    case u ~ us => (u :: us) map (m => phrase(gm)(new lexical.Scanner((LOCUTOR_MODELS / (m.toLowerCase + ".gm")).content)) match {
      case Success(result, _) => result
      case n@_                => throw new Exception("GM parsing error: " + n)
    })
  }
  
  lazy val stmts = ((enum*) ~ (clazz*)) ^^ { case enums ~ classes => enums ::: classes }
  
  lazy val enum = ("enum" ~> annotated_ident) ~ ("{" ~> repsep((annotated_ident ~ opt("=" ~> expr)), ",")) <~ "}" ^^ {
    case id ~ is => "enum " + id + ((is map {case i ~ Some(v) => i+"="+v case i ~ None => i}) mkString (" {", ",", "}"))
  }                                                
  
  lazy val clazz = opt("abstract") ~ opt("const") ~ (node_class | edge_class) ^^ {
    case abst ~ cons ~ clazz =>
      (abst match {case Some(_) => "abstract " case _ => ""}) + 
      (cons match {case Some(_) => "const " case _ => ""}) +
      clazz
  }
  
  private lazy val node_class =
    ( ("node" ~ "class") ~> (annotated_ident ~ opt(class_extends)) <~ ";" ^^ {
      case id ~ ex => "node class " + id + ∑(ex) + ";"
    }
    | ("node" ~ "class") ~> (annotated_ident ~ opt(class_extends)) ~ ("{" ~> ((class_attribute)*) <~ "}") ^^ {
      case id ~ ex ~ as => "node class " + id + ∑(ex) + (as mkString (" {", "", "}"))
    }
    )
  
  private lazy val edge_class = 
    ( opt(direction) ~ (("edge" ~ "class") ~> annotated_ident) ~ opt(class_extends) ~ (opt(connect) <~ ";") ^^ {
      case dir ~ id ~ ex ~ cs => ∑(dir) + "edge class " + id + ∑(ex) + ∑(cs) + ";"
    }
    | opt(direction) ~ (("edge" ~ "class") ~> annotated_ident) ~ opt(class_extends) ~ opt(connect) ~ ("{" ~> ((class_attribute)*) <~ "}") ^^ {
      case dir ~ id ~ ex ~ cs ~ as => ∑(dir) + "edge class " + id + ∑(ex) + ∑(cs) + (as mkString (" {", "", "}"))
    }
    )

  private lazy val direction = "arbitrary" ^^^ {"arbitrary "} | "undirected" ^^^ {"undirected "} | "directed" ^^^ {"directed "}

  private lazy val connect = "connect" ~> (assertion ~ (("," ~> assertion)*)) ^^ { case c ~ cs => " connect "+((c :: cs) mkString ",") }

  private lazy val assertion =
    ( "inherited"
    | ident ~ opt(range) ~ ("->" | "<->" | "--") ~ ident ~ opt(range) ^^ {
      case dom ~ domr ~ d ~ cod ~ codr => dom + ∑(domr) + d + cod + ∑(codr)  
    }
    )
  
  private lazy val class_extends = "extends" ~> (ident ~ (("," ~> ident)*)) ^^ { case i ~ is => " extends "+((i :: is) mkString ",") }

  private lazy val class_attribute = 
    ( annotated_ident ~ (":" ~> class_attribute_types) ~ opt("=" ~> expr) <~ ";" ^^ {
      case id ~ t ~ e => id + ":" + t + (e match {case Some(x) => "="+x case _ => ""}) + ";"
    }
    | annotated_ident ~ ("=" ~> expr <~ opt(";")) ^^ {
      case id ~ e => id + "=" + e + ";"
    }
    )
  
  private lazy val class_attribute_types = ident | primitives | ("set" ~ "<") ~> primitives <~ ">" ^^ {case p => "set<"+p+">"}
  
  override lazy val string = accept("string",  {case lexical.StringLit(n) => n mkString ("\"", "", "\"") })

}